home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ppfont10 / ppfontnm.frm < prev    next >
Text File  |  1995-05-08  |  3KB  |  114 lines
  1. VERSION 2.00
  2. Begin Form fontform 
  3.    Caption         =   "PPFont Demo"
  4.    ClientHeight    =   3900
  5.    ClientLeft      =   1620
  6.    ClientTop       =   1545
  7.    ClientWidth     =   5745
  8.    Height          =   4305
  9.    Left            =   1560
  10.    LinkTopic       =   "Form2"
  11.    ScaleHeight     =   3900
  12.    ScaleWidth      =   5745
  13.    Top             =   1200
  14.    Width           =   5865
  15.    Begin ListBox List2 
  16.       Height          =   1395
  17.       Left            =   3960
  18.       TabIndex        =   1
  19.       Top             =   600
  20.       Width           =   1575
  21.    End
  22.    Begin ListBox List1 
  23.       Height          =   3150
  24.       Left            =   180
  25.       Sorted          =   -1  'True
  26.       TabIndex        =   0
  27.       Top             =   600
  28.       Width           =   3615
  29.    End
  30.    Begin Label Label2 
  31.       Alignment       =   2  'Center
  32.       Caption         =   "True Type Full Names"
  33.       Height          =   435
  34.       Left            =   4200
  35.       TabIndex        =   3
  36.       Top             =   120
  37.       Width           =   1155
  38.    End
  39.    Begin Label Label1 
  40.       Caption         =   "Family"
  41.       Height          =   315
  42.       Left            =   180
  43.       TabIndex        =   2
  44.       Top             =   300
  45.       Width           =   1515
  46.    End
  47. End
  48. Declare Function PPFontFamNames Lib "PPFONT.DLL" (ByVal hwnd As Integer, afn As lfFaceName, aft As Integer) As Integer
  49. Declare Function PPFontFamNum Lib "PPFONT.DLL" (ByVal hwnd As Integer) As Integer
  50.  
  51. Declare Function PPFontNames Lib "PPFONT.DLL" (ByVal hwnd As Integer, afn As lfFullName, aft As Integer, ByVal afamily As String) As Integer
  52. Declare Function PPFontNum Lib "PPFONT.DLL" (ByVal hwnd As Integer, ByVal afamily As String) As Integer
  53.  
  54.  
  55.  
  56. Sub Form_Load ()
  57.     Static ftype() As Integer
  58.     Static lf() As lfFaceName
  59.  
  60.     n = PPFontFamNum(hwnd)
  61.     
  62.     ReDim lf(n), ftype(n)
  63.  
  64.     i = PPFontFamNames(hwnd, lf(1), ftype(1))
  65.  
  66.     For j = 1 To i
  67.         ft$ = "Vector"
  68.         If ftype(j) And TRUETYPE_FONTTYPE Then
  69.            ft$ = "TrueType"
  70.         Else
  71.            If ftype(j) And RASTER_FONTTYPE Then
  72.               ft$ = "Raster"
  73.            End If
  74.         End If
  75.  
  76.         font$ = lf(j).FaceName
  77.         For k = 1 To LF_FACESIZE
  78.             If Asc(Mid$(font$, k, 1)) = 0 Then
  79.                Exit For
  80.             End If
  81.         Next
  82.         font$ = Mid$(font$, 1, k - 1)
  83.  
  84.         l = Len(ft$)
  85.  
  86.         list1.AddItem font$ + "   * " + ft$
  87.     Next
  88.     list1.ListIndex = 4
  89.     list1_click
  90. End Sub
  91.  
  92. Sub list1_click ()
  93.     Static lf() As lfFullName
  94.     Static ftype() As Integer
  95.  
  96.     list2.Clear
  97.  
  98.     selfont$ = list1.List(list1.ListIndex)
  99.     n = InStr(selfont$, "*")
  100.     selfont$ = Trim(Mid$(selfont$, 1, n - 4))
  101.  
  102.     n = PPFontNum(hwnd, selfont$)
  103.  
  104.     ReDim lf(n), ftype(n)
  105.  
  106.     i = PPFontNames(hwnd, lf(1), ftype(1), selfont$)
  107.     If ftype(1) And TRUETYPE_FONTTYPE Then
  108.        For j = 1 To i
  109.            list2.AddItem lf(j).FullName
  110.        Next
  111.     End If
  112. End Sub
  113.  
  114.